perm filename SLUG.F4[CMS,LCS] blob sn#100906 filedate 1974-05-08 generic text, type T, neo UTF8
00100		DIMENSION NL(72),NE(100),IE(2000),NW(1000)
00200		COMMON NL,NE,IE,NW,J,M,N
00300	
00400	1	J=J+1
00500		L=0
00600		CALL IREAD(L)
00700		IF(L)GO TO 1
00800		J=J-1
00900		TYPE 10
01000	10	FORMAT(' TYPE LINE NUM'/)
01100		ACCEPT 11,NA
01200	11	FORMAT(A1)
01300		IF(NA.NE.' ')GO TO 33
01400		LN=0
01500	35	LN=LN+1
01600	36	IF(LN.GT.J)GO TO 1
01700		CALL IRITE(LN)
01800	25	TYPE 14,NL
01900	14	FORMAT(1X72A1/)
02000		IF(NA.EQ.' ')GO TO 35
02100		GO TO 1
02200	33	REREAD 34,LN
02300	34	FORMAT(I2)
02400		IF(LN.LT.1)GO TO 13
02500		GO TO 36
02600	13	TYPE 6,(NE(I),I=1,J)
02700	6	FORMAT(1X10I7)
02800		TYPE 6,(IE(I),I=1,M)
02900		TYPE 7,(NW(I),I=1,N)
03000	7	FORMAT(1X70A1)
03100		TYPE 8,J,M,N
03200	8	FORMAT(1X3I/)
03300		GO TO 1
03400		END
03500	
03600		SUBROUTINE IREAD(L)
03700		COMMON NL(72),NE(100),IE(2000),NW(1000),J,M,N
03800		LT=0
03900	1	ACCEPT 2,NL
04000	2	FORMAT(72A1)
04100		CALL JOKES(LT,NL(1))
04200		IF(LT)GO TO 4
04300		IF(L)GO TO 1
04400		RETURN
04500	
04600	4	CALL DOG(NL,J,M,N,NE,IE,NW)
04700		L=-1
04800		RETURN
04900		END
05000	
05100		SUBROUTINE IRITE(LN)
05200		COMMON NL(72),NE(100),IE(2000),NW(1000),J,M,N
05300		I=0
05400		NN=NE(LN)/1000
05500		MM=MOD(NE(LN),1000)+1
05600	23	I=I+1
05700		IF(NN.EQ.MM)GO TO 19
05800		KM=IE(NN)/100
05900		LL=KM+MOD(IE(NN),100)
06000	24	IF(KM.EQ.LL)GO TO 20
06100		NL(I)=NW(KM)
06200		IF(I.EQ.72)RETURN
06300		KM=KM+1
06400		I=I+1
06500		GO TO 24
06600	20	IF(NN.LT.MM)NN=NN+1
06700	19	NL(I)=' '
06800		IF(I.EQ.72)RETURN
06900		GO TO 23	
07000		END
07100